module Parser (
    Parser.parse,
    name,
    Thinder
) where

import Lexer
import System.IO
import ParseLib.Simple as PL

run :: Parser a b -> [a] -> b
run p i = process (PL.parse p i)
          where process [] = error "Parser: Syntax error!"
                process ((a, []):xs) = a
                process ((a, rest):xs) = process xs 

--parse :: [Token] -> Thinder
parse = run thinder 

optionalListOf p s = listOf p s <|> succeed []


--                      Namespace   Imports Decl
data Thinder = Thinder (Maybe Name) [Name]  [Decl]
      deriving Show
      
--          List of identifiers seperated by dots            
type Name = [Ident] 
type Ident = (String, AlexPosn) 

--
data Decl = VarDecl [Modifier] Type [Var]
          | FunctionDecl FunctionHeader Statement
          | ClassDecl [Modifier] Ident [Name] [ClassDecls]
          deriving Show
                   
data FunctionHeader = FunctionHeader [Modifier] Type Ident [FormPar]
                    | OperatorHeader [Modifier] Type Operator [FormPar]
            deriving Show
            
data FormPar = FormPar Type Ident
            deriving Show          

data ClassDecls = FieldMethDecl Decl
                | ConstructorDecl [Modifier] Ident [FormPar] Statement
                deriving Show

--                         Dimension
data Type = Type TypeIdentifier [Expr]
            deriving Show
            
data TypeIdentifier = PrimitiveType Primitive | UserType Name
            deriving Show
            
data Block = Block [Statement]
            deriving Show

data Statement = BlockStatement Block 
               | DeclStatement Decl 
               | ExprStatement StatExpr
               | ReturnStatement Expr
               | ForStatement Statement Statement Statement Statement
            deriving Show
            
data StatExpr = StatDesignator Designator
              | StatExpr Expr
            deriving Show
            
data Expr = ExprOp OpExpr 
          | ExprAss Assignment
            deriving Show
          
data OpExpr = OpExpr Unary Operator OpExpr
            | OpSingle Unary
            | OpExprEmpty
            deriving Show

            --      Prefix             Postfix 
data Unary = Unary [Operator] Primary [Operator]
            deriving Show

data Primary = Primary PrimaryExpression PrimaryPost
            deriving Show

data PrimaryExpression = PrimaryLiteral Literal
                       | PrimaryIdent Ident
                       | PrimaryExpr Expr
                       | PrimaryCast Type Primary
                       | PrimaryNew Name [Expr]
            deriving Show
    
data PrimaryPost = PrimaryPostIdent Ident PrimaryPost
                 | PrimaryPostArray Expr PrimaryPost
                 | PrimaryPostFunc [Expr] PrimaryPost
                 | PrimaryPostEmpty
            deriving Show
            
data Literal = LiteralInt String
             | LiteralFloat String
             | LiteralString String
             | LiteralChar String
            deriving Show
                       
data Operator = Operator String 
            deriving Show
          
data Assignment = Assignment Designator Operator Expr
            deriving Show

data Designator = Designator Ident [IdentRest]
            deriving Show

data IdentRest = IRIdent Ident | IRArray Expr | IRFunc [Expr]
            deriving Show

data Var = Var Ident | VarInit Ident Expr 
            deriving Show
            
getIdentName :: Token -> String
getIdentName (TokenIdentifier _ s) = s


getIdentPosn :: Token -> AlexPosn
getIdentPosn (TokenIdentifier p _) = p
            
getIdent :: Token -> Ident
getIdent t = ((getIdentName t), (getIdentPosn t))

-- Tokens
tnamespace :: Parser Token Token
tnamespace (t@(TokenNamespace _ _) : ts) = [(t, ts)]
tnamespace _ = []

timport :: Parser Token Token
timport (t@(TokenImport _ _) : ts) = [(t, ts)]
timport _ = []

tnew :: Parser Token Token
tnew (t@(TokenNew _ _) : ts) = [(t, ts)]
tnew _ = []

tclass :: Parser Token Token
tclass (t@(TokenClass _ _) : ts) = [(t, ts)]
tclass _ = []

textends :: Parser Token Token
textends (t@(TokenExtends _ _) : ts) = [(t, ts)]
textends _ = []

treturn :: Parser Token Token
treturn (t@(TokenReturn _ _) : ts) = [(t, ts)]
treturn _ = []

tfor :: Parser Token Token
tfor (t@(TokenFor _ _) : ts) = [(t, ts)]
tfor _ = []

tkoperator :: Parser Token Token
tkoperator (t@(TokenKOperator _ _) : ts) = [(t, ts)]
tkoperator _ = []

tsemicolon :: Parser Token Token
tsemicolon (t@(TokenSemicolon _ _) : ts) = [(t, ts)]
tsemicolon _ = []

tident :: Parser Token Token
tident (t@(TokenIdentifier _ _) : ts) = [(t, ts)]
tident _ = []

tdot :: Parser Token Token
tdot (t@(TokenDot _ _) : ts) = [(t, ts)]
tdot _ = []

tcomma :: Parser Token Token
tcomma (t@(TokenComma _ _) : ts) = [(t, ts)]
tcomma _ = []

tbracketopen :: Parser Token Token
tbracketopen (t@(TokenBracketOpen _ _) : ts) = [(t, ts)]
tbracketopen _ = []

tbracketclose :: Parser Token Token
tbracketclose (t@(TokenBracketClose _ _) : ts) = [(t, ts)]
tbracketclose _ = []

tparenopen :: Parser Token Token
tparenopen (t@(TokenParenOpen _ _) : ts) = [(t, ts)]
tparenopen _ = []

tparenclose :: Parser Token Token
tparenclose (t@(TokenParenClose _ _) : ts) = [(t, ts)]
tparenclose _ = [] 

tcurlyopen :: Parser Token Token
tcurlyopen (t@(TokenCurlyOpen _ _) : ts) = [(t, ts)]
tcurlyopen _ = []

tcurlyclose :: Parser Token Token
tcurlyclose (t@(TokenCurlyClose _ _) : ts) = [(t, ts)]
tcurlyclose _ = [] 

tmodifier :: Parser Token Token
tmodifier (t@(TokenModifier _ _) : ts) = [(t, ts)]
tmodifier _ = []

tprimitive :: Parser Token Token
tprimitive (t@(TokenPrimitive _ _) : ts) = [(t, ts)]
tprimitive _ = []

tassop :: Parser Token Token
tassop (t@(TokenAssignmentOperator _ _) : ts) = [(t, ts)]
tassop _ = []

tplus :: Parser Token String
tplus (t@(TokenPlus _ _) : ts) = [(tokenGetValue t, ts)]
tplus _ = []

tmin :: Parser Token String
tmin (t@(TokenMin _ _) : ts) = [(tokenGetValue t, ts)]
tmin _ = []

texclaimation :: Parser Token String
texclaimation (t@(TokenNot _ _) : ts) = [(tokenGetValue t, ts)]
texclaimation _ = []

twiggly :: Parser Token String
twiggly (t@(TokenWiebel _ _) : ts) = [(tokenGetValue t, ts)]
twiggly _ = []

tplusplus :: Parser Token String
tplusplus (t@(TokenPlusPlus _ _) : ts) = [(tokenGetValue t, ts)]
tplusplus _ = []

tminmin :: Parser Token String
tminmin (t@(TokenMinMin _ _) : ts) = [(tokenGetValue t, ts)]
tminmin _ = []

tstringliteral :: Parser Token String
tstringliteral (t@(TokenStringLiteral _ _) : ts) = [(tokenGetValue t, ts)]
tstringliteral _ = []

tintliteral :: Parser Token String
tintliteral (t@(TokenInt _ _) : ts) = [(tokenGetValue t, ts)]
tintliteral _ = []

tfloatliteral :: Parser Token String
tfloatliteral (t@(TokenFloat _ _) : ts) = [(tokenGetValue t, ts)]
tfloatliteral _ = []

tcharliteral :: Parser Token String
tcharliteral (t@(TokenCharLiteral _ _) : ts) = [(tokenGetValue t, ts)]
tcharliteral _ = []

toperator :: Parser Token String
toperator (t@(TokenOperator _ _) : ts) = [(tokenGetValue t, ts)]
toperator _ = []


-- Productions and the parsers

thinder = (\n i d -> Thinder n i d) <$> optional (tnamespace *> name <* tsemicolon) 
                                        <*> many (timport *> name <* tsemicolon)
                                        <*> many decl

name :: Parser Token Name
name = listOf ident tdot

ident :: Parser Token Ident
ident = (\(TokenIdentifier p s) -> (s, p)) <$> tident

decl :: Parser Token Decl
decl = VarDecl <$> many modifier <*> ptype <*> listOf var tcomma <* tsemicolon <|>
       FunctionDecl <$> functionheader <*> statement <|>
       (\a b -> FunctionDecl a (ReturnStatement b)) <$> functionheader <* equals <*> expr <* tsemicolon <|>
       (\a b c -> ClassDecl a b [] c) <$> many modifier <* tclass <*> ident <* tcurlyopen <*> many classdecls <* tcurlyclose <|>
       ClassDecl <$> many modifier <* tclass <*> ident <* textends <*> listOf name tcomma <* tcurlyopen <*> many classdecls <* tcurlyclose

classdecls :: Parser Token ClassDecls
classdecls = FieldMethDecl <$> decl <|>
             ConstructorDecl <$> many modifier <*> ident <*> pack tparenopen (optionalListOf formpar tcomma) tparenclose <*> statement

equals :: Parser Token Token
equals (t@(TokenAssignmentOperator _ "=") : ts) = [(t, ts)]
equals _ = []

modifier :: Parser Token Modifier
modifier = (\(TokenModifier p m) -> m) <$> tmodifier

ptype :: Parser Token Type
ptype = Type <$> typeidentifier <*> many arrayexpr

typeidentifier :: Parser Token TypeIdentifier
typeidentifier = PrimitiveType <$> primitive <|>
                 UserType <$> name

primitive :: Parser Token Primitive
primitive = (\(TokenPrimitive p pr) -> pr) <$> tprimitive

dimension :: Parser Token Int
dimension = length <$> many (tbracketopen <* tbracketclose)

var :: Parser Token Var
var = VarInit <$> ident <* equals <*> expr <|>
      Var     <$> ident 

functionheader :: Parser Token FunctionHeader
functionheader = FunctionHeader <$> many modifier <*> ptype <*> ident <*> pack tparenopen (optionalListOf formpar tcomma) tparenclose <|>
                 OperatorHeader <$> many modifier <*> ptype <* tkoperator <*> pack tparenopen operator tparenclose <*> pack tparenopen (optionalListOf formpar tcomma) tparenclose

formpar :: Parser Token FormPar
formpar = FormPar <$> ptype <*> ident

block :: Parser Token Block
block = Block <$ tcurlyopen <*> many statement <* tcurlyclose 

statement :: Parser Token Statement
statement = BlockStatement  <$> block <|>
            DeclStatement   <$> decl  <|>
            ExprStatement   <$> statexpr <* tsemicolon <|>
            ReturnStatement <$ treturn <*> expr <* tsemicolon <|>
            ForStatement    <$ tfor <* tparenopen <*> statement <*> statement <*> statement <* tparenclose <*> statement
            
            -- TODO For statement 

statexpr :: Parser Token StatExpr
statexpr = StatDesignator <$> designator <|>
           StatExpr <$> expr

actpars :: Parser Token [Expr]
actpars = pack tparenopen (optionalListOf expr tcomma) tparenclose

assignment :: Parser Token Assignment
assignment = Assignment <$> designator <*> assop <*> expr

assop :: Parser Token Operator
assop = (\(TokenAssignmentOperator p s) -> Operator s) <$> tassop

expr :: Parser Token Expr
expr = ExprOp  <$> opexpr <|>
       ExprAss <$> assignment 

opexpr :: Parser Token OpExpr
opexpr = OpExpr   <$> unary <*> operator <*> opexpr <|>
         OpSingle <$> unary

unary :: Parser Token Unary
unary = Unary <$> many prefixoperator <*> primary <*> many postfixoperator

prefixoperator :: Parser Token Operator
prefixoperator = Operator <$> tplus <|>
                 Operator <$> tmin <|>
                 Operator <$> texclaimation <|>
                 Operator <$> twiggly <|>
                 Operator <$> tplusplus <|>
                 Operator <$> tminmin

postfixoperator :: Parser Token Operator
postfixoperator = Operator <$> tplusplus <|>
                  Operator <$> tminmin

primary :: Parser Token Primary
primary = Primary <$> primaryexpression <*> primarypost

primaryexpression :: Parser Token PrimaryExpression
primaryexpression = PrimaryLiteral <$> literal <|>
                    PrimaryIdent <$> ident <|>
                    PrimaryExpr <$ tparenopen <*> expr <* tparenclose <|>
                    PrimaryCast <$ tparenopen <*> ptype <* tparenclose <*> primary <|>
                    PrimaryNew <$ tnew <*> name <*> actpars

primarypost :: Parser Token PrimaryPost
primarypost = PrimaryPostIdent <$ tdot <*> ident <*> primarypost <|>
              PrimaryPostArray <$> arrayexpr <*> primarypost <|>
              PrimaryPostFunc  <$> actpars <*> primarypost <|>
              const PrimaryPostEmpty <$> epsilon 

arrayexpr :: Parser Token Expr
arrayexpr = pack tbracketopen expr tbracketclose

designator :: Parser Token Designator
designator = Designator <$> ident <*> many identrest

identrest :: Parser Token IdentRest
identrest = IRIdent <$ tdot <*> ident <|>
            IRArray <$> arrayexpr <|>
            IRFunc  <$> actpars

literal :: Parser Token Literal
literal = LiteralString <$> tstringliteral <|>
          LiteralFloat  <$> tfloatliteral <|>
          LiteralInt    <$> tintliteral <|>
          LiteralChar   <$> tcharliteral

operator :: Parser Token Operator
operator = Operator <$> (toperator <|> tplus <|> tmin <|> tplusplus <|> tminmin)
           
